home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / xlibpas2.zip / XLA2.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-08  |  28KB  |  1,278 lines
  1. {╔══════════════════════════════════════════════════════════════════════════╗
  2.  ║                                                                          ║
  3.  ║                   XLIB v2.0 for BORLAND/TURBO PASCAL 7.0                 ║
  4.  ║                Tristan Tarrant ( tristant@cogs.susx.ac.uk )              ║
  5.  ║                                                                          ║
  6.  ╠══════════════════════════════════════════════════════════════════════════╣
  7.  ║ Credits :                                                                ║
  8.  ║   Michael Abrash - Concept and Algorithms                                ║
  9.  ║   Themie Gouthas - Original code                                         ║
  10.  ║   Michael McKenzie - More code                                           ║
  11.  ║   Tore Bastiansen - Virtual VSync Handler code                           ║
  12.  ║   Andy Tam/Douglas Webb - LZS compression                                ║
  13.  ╚══════════════════════════════════════════════════════════════════════════╝}
  14.  
  15. {$G+,N-,E-}
  16.  
  17. Unit XLA2;
  18.  
  19. Interface
  20.  
  21. Uses
  22.     XMisc2, Dos;
  23.  
  24. Const
  25.     None = 0;
  26.     LZS  = 1;
  27.     Best = 8; {Not Used}
  28.  
  29. Type
  30.     XLAOutProcType = procedure( var Data; size : word );
  31.     XLAInProcType  = procedure( var Data; size : word; var actual : longint );
  32.  
  33. Var
  34.     ModeUsed : word;
  35.     XLAOutProc : XLAOutProcType;
  36.     XLAInProc  : XLAInProcType;
  37.  
  38. Function  XLZSSave( FName : string ) : boolean;
  39. Function  XLZSLoad( FName : string ) : boolean;
  40. procedure XPrintDir;
  41. function  XCloseArchive : boolean;
  42. function  XUpdateArchive( filename : string ) : boolean;
  43. function  XOpenArchive( filename : string ) : boolean;
  44. function  XLAGet( fname : string ) : boolean;
  45. function  XLAPut( fname : string; mode : word ) : boolean;
  46. function  XEndArchive : boolean;
  47. function  XCreateArchive( filename : string ) : boolean;
  48. function  XLAGetFileInfo( fname : string; var origsize, compsize : longint; mode : word ) : boolean;
  49. function  XLAFindFirst( pattern : string; var match : string ) : boolean;
  50. function  XLAFindNext( var match : string ) : boolean;
  51.  
  52. Implementation
  53.  
  54. const
  55.     TableSize = 5003;
  56.     LargestCode = 4095;
  57.     NoCode = -1;
  58.     N           = 4096;
  59.     F           = 18;
  60.     THRESHOLD   = 2;
  61.     NUL         = N * 2;
  62.  
  63.     BUFSIZE = 1024;
  64.     InBufPtr  : WORD = BUFSIZE;
  65.     InBufSize : WORD = BUFSIZE;
  66.     OutBufPtr : WORD = 0;
  67.  
  68. Type
  69.     PWorkspace = ^TWorkspace;
  70.     TWorkspace = record
  71.         TextBuf : Array[0.. N + F - 2] OF byte;
  72.         Left,Mom:  Array [0..N] OF word;
  73.         Right: Array [0..N + 256] OF word;
  74.     end;
  75.  
  76.     THeader = record
  77.         sig : array[0..3] of char;
  78.         posdir, sizedir : longint;
  79.     end;
  80.  
  81.     TFile = record
  82.         name : array[0..11] of char;
  83.         posfile, sizefile, sizecomp : longint;
  84.         algorithm : word;
  85.     end;
  86.  
  87.     PXLADir = ^TXLADir;
  88.     TXLADir = record
  89.         item : TFile;
  90.         next : PXLADir;
  91.     end;
  92.  
  93. Var
  94.     XLAFile : File;
  95.     Header : THeader;
  96.     XLADir, CurrentDir : PXLADir;
  97.     TotalSize, BytesWritten : longint;
  98.  
  99.     printcount, height,
  100.     matchPos, matchLen,
  101.     lastLen, printPeriod : WORD;
  102.     opt : BYTE;
  103.     SearchPattern : string;
  104.  
  105.     Workspace : PWorkspace;
  106.  
  107.     codeBuf: Array [0..16] of BYTE;
  108.  
  109.     Inbuf,OutBuf : Array[0..PRED(BUFSIZE)] of BYTE;
  110.  
  111.     ArchiveOpen : boolean;
  112.  
  113. Procedure InitBuffers;
  114. var
  115.     tmp : ^byte;
  116. begin
  117.     while true do
  118.     begin
  119.         new( Workspace );
  120.         if ofs(Workspace^)<>0 then
  121.         begin
  122.             dispose( Workspace );
  123.             new( tmp );
  124.         end else break;
  125.     end;
  126. end;
  127.  
  128. Procedure CleanUp;
  129. begin
  130.     Dispose( Workspace );
  131. end;
  132.  
  133. procedure CleanUpAll;
  134. var
  135.     tmp : PXLADir;
  136. begin
  137.     while XLADir<>nil do
  138.     begin
  139.         tmp := XLADir^.next;
  140.         dispose( XLADir );
  141.         XLADir := tmp;
  142.     end;
  143.     CleanUp;
  144. end;
  145.  
  146.  
  147. Function MemoryReadChunk: word;
  148.  
  149. var
  150.     Actual : longint;
  151.  
  152. begin
  153.     XLAInProc( InBuf, BufSize, Actual );
  154.     TotalSize := TotalSize + Actual;
  155.     MemoryReadChunk := Actual;
  156. end;
  157.  
  158. Procedure MemoryGetc; Assembler;
  159. asm
  160.     push    bx
  161.     mov     bx, inBufPtr
  162.     cmp     bx, inBufSize
  163.     jb      @getc1
  164.     push    cx
  165.     push    dx
  166.     push    di
  167.     push    si
  168.     call    MemoryReadChunk
  169.     pop     si
  170.     pop     di
  171.     pop     dx
  172.     pop     cx
  173.     mov     inBufSize, ax
  174.     or      ax, ax
  175.     jz      @getc2
  176.     xor     bx, bx
  177. @getc1:
  178.     mov     al, [Offset InBuf + bx]
  179.     inc     bx
  180.     mov     inBufPtr, bx
  181.     pop     bx
  182.     clc
  183.     jmp     @end
  184. @getc2:
  185.     pop     bx
  186.     stc
  187. @end:
  188. end;
  189.  
  190. Function DiskReadChunk: word;
  191.  
  192. var
  193.     Actual : WORD;
  194.  
  195. begin
  196.     if Bufsize > TotalSize then
  197.         Actual := TotalSize
  198.     else
  199.         Actual := BufSize;
  200.     if Actual > 0 then BlockRead(XLAFile,InBuf,Actual);
  201.     TotalSize := TotalSize - Actual;
  202.     DiskReadChunk := Actual;
  203. end;
  204.  
  205. Procedure DiskGetc; Assembler;
  206. asm
  207.     push    bx
  208.     mov     bx, inBufPtr
  209.     cmp     bx, inBufSize
  210.     jb      @getc1
  211.     push    cx
  212.     push    dx
  213.     push    di
  214.     push    si
  215.     call    DiskReadChunk
  216.     pop     si
  217.     pop     di
  218.     pop     dx
  219.     pop     cx
  220.     mov     inBufSize, ax
  221.     or      ax, ax
  222.     jz      @getc2
  223.     xor     bx, bx
  224. @getc1:
  225.     mov     al, [Offset InBuf + bx]
  226.     inc     bx
  227.     mov     inBufPtr, bx
  228.     pop     bx
  229.     clc
  230.     jmp     @end
  231. @getc2:
  232.     pop     bx
  233.     stc
  234. @end:
  235. end;
  236.  
  237. Procedure MemoryWriteout;
  238. begin
  239.     XLAOutProc( OutBuf, OutBufPtr );
  240.     BytesWritten := BytesWritten + OutBufPtr;
  241. end;
  242.  
  243. Procedure MemoryPutc; Assembler;
  244. asm
  245.     push    bx
  246.     mov     bx, outBufPtr
  247.     mov     [OFFSet OutBuf + bx], al
  248.     inc     bx
  249.     cmp     bx, BUFSIZE
  250.     jb      @putc1
  251.     mov     OutBufPtr,BUFSIZE
  252.     push    cx
  253.     push    dx
  254.     push    di
  255.     push    si
  256.     call    MemoryWriteOut
  257.     pop     si
  258.     pop     di
  259.     pop     dx
  260.     pop     cx
  261.     xor     bx, bx
  262. @putc1:
  263.     mov     outBufPtr, bx
  264.     pop     bx
  265. end;
  266.  
  267. Procedure DiskWriteout;
  268. var
  269.     Actual : WORD;
  270.  
  271. begin
  272.     BlockWrite(XLAFile,OutBuf,OutBufPtr,Actual);
  273.     BytesWritten := BytesWritten + OutBufPtr;
  274. end;
  275.  
  276. Procedure DiskPutc; Assembler;
  277. asm
  278.     push    bx
  279.     mov     bx, outBufPtr
  280.     mov     [OFFSet OutBuf + bx], al
  281.     inc     bx
  282.     cmp     bx, BUFSIZE
  283.     jb      @putc1
  284.     mov     OutBufPtr,BUFSIZE
  285.     push    cx
  286.     push    dx
  287.     push    di
  288.     push    si
  289.     call    DiskWriteOut
  290.     pop     si
  291.     pop     di
  292.     pop     dx
  293.     pop     cx
  294.     xor     bx, bx
  295. @putc1:
  296.     mov     outBufPtr, bx
  297.     pop     bx
  298. end;
  299.  
  300.  
  301. PROCEDURE LZSInitTree; Assembler;
  302. ASM
  303.     cld
  304.     les     ax, Workspace
  305.     mov     di, offset TWorkspace.Right
  306.     add     di, (N + 1) * 2
  307.     mov     cx, 256
  308.     mov     ax, NUL
  309.     rep     stosw
  310.     mov     di, offset TWorkspace.mom
  311.     mov     cx, N
  312.     rep     stosw
  313. END;
  314.  
  315.  
  316. PROCEDURE LZSSplay; Assembler;
  317. ASM
  318.     les     si, Workspace
  319. @Splay1:
  320.     mov     si, es:[Offset TWorkspace.Mom + di]
  321.     cmp     si, NUL
  322.     ja      @Splay4
  323.     mov     bx, es:[Offset TWorkspace.Mom + si]
  324.     cmp     bx, NUL
  325.     jbe     @Splay5
  326.     cmp     di, es:[Offset TWorkspace.Left + si]
  327.     jne     @Splay2
  328.     mov     dx, es:[Offset TWorkspace.Right + di]
  329.     mov     es:[Offset TWorkspace.Left + si], dx
  330.     mov     es:[Offset TWorkspace.Right + di], si
  331.     jmp     @Splay3
  332. @Splay2:
  333.     mov     dx, es:[Offset TWorkspace.Left + di]
  334.     mov     es:[Offset TWorkspace.Right + si], dx
  335.     mov     es:[Offset TWorkspace.Left + di], si
  336. @Splay3:
  337.     mov     es:[Offset TWorkspace.Right + bx], di
  338.     xchg    bx, dx
  339.     mov     es:[Offset TWorkspace.Mom + bx], si
  340.     mov     es:[Offset TWorkspace.Mom + si], di
  341.     mov     es:[Offset TWorkspace.Mom + di], dx
  342. @Splay4:
  343.     jmp     @end
  344. @Splay5:
  345.     mov     cx, es:[Offset TWorkspace.Mom + bx]
  346.     cmp     di, es:[Offset TWorkspace.Left + si]
  347.     jne     @Splay7
  348.     cmp     si, es:[Offset TWorkspace.Left + bx]
  349.     jne     @Splay6
  350.     mov     dx, es:[Offset TWorkspace.Right + si]
  351.     mov     es:[Offset TWorkspace.Left + bx], dx
  352.     xchg    bx, dx
  353.     mov     es:[Offset TWorkspace.Mom + bx], dx
  354.     mov     bx, es:[Offset TWorkspace.Right + di]
  355.     mov     es:[Offset TWorkspace.Left +si], bx
  356.     mov     es:[Offset TWorkspace.Mom + bx], si
  357.     mov     bx, dx
  358.     mov     es:[Offset TWorkspace.Right + si], bx
  359.     mov     es:[Offset TWorkspace.Right + di], si
  360.     mov     es:[Offset TWorkspace.Mom + bx], si
  361.     mov     es:[Offset TWorkspace.Mom + si], di
  362.     jmp     @Splay9
  363. @Splay6:
  364.     mov     dx, es:[Offset TWorkspace.Left + di]
  365.     mov     es:[Offset TWorkspace.Right + bx], dx
  366.     xchg    bx, dx
  367.     mov     es:[Offset TWorkspace.Mom + bx], dx
  368.     mov     bx, es:[Offset TWorkspace.Right + di]
  369.     mov     es:[Offset TWorkspace.Left + si], bx
  370.